CD ROM Paradise Collection 4/CD ROM Paradise Collection 4 1995 Nov.iso/business/cmplusb.zip/CMPLUS2.LZH/_PS.PRO

Text File | 1993-06-22 | 18KB | 616 lines

%%DocumentFonts: (atend)
%%Creator: GRAF/DRIVE PLUS
%%EndComments

%* GRAF/DRIVE PLUS Copyright (C) 1990-91  M.K. Fleming  All Rights Reserved

% -------------------------- VARIABLE LIST --------------------------------
%
% PERMANENT DEFINITIONS:
% StdLine                         1-unit line width in decipoints
%
% CURRENT STATUS INFO:
% CurFont                         current font
% TxtDir                          text direction (0=horizontal, 1=vertical)
% TxtHt                           text height
% FillColor                       filling color
% DrawColor                       drawing color
% AuxColor                        fill interior color
% FillStyle                       fill pattern id
% LineWidth                       line width (as multiple of StdLine)
% LineStyle                       line pattern
% UserPat                         user-defined fill pattern
% ptm                             pattern matrix
%
%
% TEMPORARY, WORKING VALUES:
% x1,y1,x2,y2                     rectangle coordinates
% top,dep,ydep,h,w                3-D bar values
% px1,py1,py2,pw,PatChar          pattern fill data
% savematrix                      temporary storage
%
% -------------------------------------------------------------------------

/GrafDrivDict 100 dict def
/ReEncodeDict 12 dict def
GrafDrivDict begin

% ---------------------- PERMANENT DEFINITIONS ----------------------------
/StdLine 2 def     % Normal line width, in decipoints
/Thick   8 def     % Thick line width, as multiple of StdLine

/CharSet
[
    10#128   /Ccedilla
    10#129   /udieresis
    10#130   /eacute
    10#131   /acircumflex
    10#132   /adieresis
    10#133   /agrave
    10#134   /aring
    10#135   /ccedilla
    10#136   /ecircumflex
    10#137   /edieresis
    10#138   /egrave
    10#139   /idieresis
    10#140   /icircumflex
    10#141   /igrave
    10#142   /Adieresis
    10#143   /Aring
    10#144   /Eacute
    10#145   /ae
    10#146   /AE
    10#147   /ocircumflex
    10#148   /odieresis
    10#149   /ograve
    10#150   /ucircumflex
    10#151   /ugrave
    10#152   /ydieresis
    10#153   /Odieresis
    10#154   /Udieresis
    10#155   /cent
    10#156   /sterling
    10#157   /yen
    10#158   /P
    10#159   /florin
    10#160   /aacute
    10#161   /iacute
    10#162   /oacute
    10#163   /uacute
    10#164   /ntilde
    10#165   /Ntilde
    10#166   /ordfeminine
    10#167   /ordmasculine
    10#168   /questiondown
] def

% --------------------------------------------------------------------
% OldName NewName AF      Encode font OldName to NewName
% --------------------------------------------------------------------
/AF
{
ReEncodeDict begin
    /NewName exch def  /OldName exch def
    FontDirectory NewName known not
    {
        FontDirectory OldName known not { /OldName /Courier def } if
        /BaseFontDict OldName findfont def
        /NewFontDict BaseFontDict maxlength dict def
        BaseFontDict
        {
            exch dup /FID ne
            {
                dup /Encoding eq
                {
                    exch dup length array copy
                    NewFontDict 3 1 roll put
                }
                {
                    exch NewFontDict 3 1 roll put
                }
                ifelse
            }
            {
                pop pop
            }
            ifelse
        } forall

        NewFontDict /FontName NewName put

        CharSet aload
        length 2 idiv
        {
            NewFontDict /Encoding get 3 1 roll put
        }
        repeat

        NewName NewFontDict definefont pop
    } if
end
} bind def


% ---------------------------------------------------------------------------
%                           PATTERN FILLS
% ---------------------------------------------------------------------------
/newfont 10 dict def
newfont begin

/FontType 3 def
/FontMatrix [ 1 0 0 1 0 0 ] def
/FontBBox [ 0 0 8 8 ] def
/Encoding 256 array def
  0 1 255 { Encoding exch /.notdef put } for
  Encoding  99 /linefill  put      % c=2
  Encoding 100 /ltslash   put      % d=3
  Encoding 101 /slash     put      % e=4
  Encoding 102 /bkslash   put      % f=5
  Encoding 103 /ltbkslash put      % g=6
  Encoding 104 /hatch     put      % h=7
  Encoding 105 /xhatch    put      % i=8
  Encoding 106 /interleav put      % j=9
  Encoding 107 /widedot   put      % k=10
  Encoding 108 /closedot  put      % l=11
  Encoding 122 /userfill  put      % z=12


/CharProcs 16 dict def
CharProcs begin
/.notdef {} bind def
/linefill  { 8 8 true [1 0 0 -1 0 8] { <ffff0000ffff0000> } imagemask } bind def
/ltslash   { 8 8 true [1 0 0 -1 0 8] { <0102040810204080> } imagemask } bind def
/slash     { 8 8 true [1 0 0 -1 0 8] { <e0c183070e1c3870> } imagemask } bind def
/bkslash   { 8 8 true [1 0 0 -1 0 8] { <f0783c1e0f87c3e1> } imagemask } bind def
/ltbkslash { 8 8 true [1 0 0 -1 0 8] { <a5d269b45a2d964b> } imagemask } bind def
/hatch     { 8 8 true [1 0 0 -1 0 8] { <ff888888ff888888> } imagemask } bind def
/xhatch    { 8 8 true [1 0 0 -1 0 8] { <8142241818244281> } imagemask } bind def
/interleav { 8 8 true [1 0 0 -1 0 8] { <cc33cc33cc33cc33> } imagemask } bind def
/widedot   { 8 8 true [1 0 0 -1 0 8] { <8000080080000800> } imagemask } bind def
/closedot  { 8 8 true [1 0 0 -1 0 8] { <8800220088002200> } imagemask } bind def
/userfill  { 8 8 true [1 0 0 -1 0 8] { UserPat            } imagemask } bind def
end

/BuildChar       % fontdic charcode BuildChar
{
    exch begin
        dup  122 eq
        {
            8 0 setcharwidth
        }{
            8 0   0 0 8 8  setcachedevice
        } ifelse
        Encoding exch get
        CharProcs exch get
    end
    exec
} bind def
end % of newfont
/PatFont newfont definefont pop

/UserPat <0001020400402010>  def
/PatChar (a) def

/patfill
{
    gsave
    eoclip
    gsave AuxColor CS fill grestore
    ptm setmatrix /PatFont findfont 1 scalefont setfont
    PatChar 0 FillStyle 97 add put

    pathbbox newpath
    4 2 roll
    cvi 3 not and /py1 exch def
    cvi 3 not and /px1 exch def
    /py2 exch def
    px1 sub 8 div ceiling cvi /pw exch def

    py1 8 py2
    {
        px1 exch moveto
        pw { PatChar show } repeat
    } for

    grestore
} bind def

% ---------------------------------------------------------------------------



/xround
{
    dup round dup 0 eq
    {
        2 -1 roll 0 lt { -1 } { 1 } ifelse
    }if
    2 -1 roll pop
} bind def

/roundup
{
    dup 0 lt {floor} {ceiling} ifelse
} bind def

/N { newpath } bind def
/M { moveto } bind def
/L { lineto } bind def
/C { closepath } bind def


% ----------------------------------------------------------------------
% x1 y1 x2 y2       REC    draw rectangle (x1,y1)-(x2,y2)
% ----------------------------------------------------------------------
/REC
{
    transform round exch round exch itransform 4 2 roll
    transform round exch round exch itransform 4 2 roll
    /y2 exch def  /x2 exch def  /y1 exch def  /x1 exch def
    newpath
    x1 y1 moveto
    x2 y1 lineto
    x2 y2 lineto
    x1 y2 lineto
    closepath
} bind def

% ----------------------------------------------------------------------
%                   SK     stroke the current path
% ----------------------------------------------------------------------
/SK
{
    gsave DrawColor CS stroke grestore newpath
} bind def

% ----------------------------------------------------------------------
%                   FILL   fill the current path
% ----------------------------------------------------------------------
/FILL
{
    gsave
    FillStyle 0 eq { AuxColor CS } { FillColor CS } ifelse
    FillStyle 1 le { eoclip fill } { patfill } ifelse
    grestore
} bind def

% ----------------------------------------------------------------------
% x1 y1 x2 y2       VEC    draw line from (x1,y1) to (x2,y2)
% ----------------------------------------------------------------------
/VEC
{
    transform round exch round exch itransform 4 2 roll
    transform round exch round exch itransform 4 2 roll
    newpath moveto lineto SK
} bind def

% ----------------------------------------------------------------------
% x1 y1             VS     start path
% ----------------------------------------------------------------------
/VS
{
    transform round exch round exch itransform
    newpath moveto
} bind def

% ----------------------------------------------------------------------
% x  y              VR     close/continue path
% ----------------------------------------------------------------------
/VR
{
    transform round exch round exch itransform
    closepath moveto
} bind def

% ----------------------------------------------------------------------
% x  y              VC     continue path
% ----------------------------------------------------------------------
/VC
{
    transform round exch round exch itransform
    lineto
} bind def

% ----------------------------------------------------------------------
% x  y  c           PX     simulated putpixel
% ----------------------------------------------------------------------
/PX
{
    gsave
    newpath CS 2 setlinewidth [] 0 setdash
    transform round exch round exch itransform moveto
    -1 0 rmoveto 1 0 rlineto stroke
    grestore
} bind def

% ----------------------------------------------------------------------
% x1 y1 x2 y2 d t   BAR    fill and outline rectangle (x1,y1)-(x2,y2)
% ----------------------------------------------------------------------
/BAR
{
    /top exch def /dep exch def
    REC FILL
    newpath
    x2 y1 moveto
    x1 y1 lineto
    x1 y2 lineto
    x2 y2 lineto
    x2 y1 lineto
    dep 0 ne { BARDEP } if
    SK
} bind def

/BARDEP
{
    dep .6 mul /ydep exch def
    y2 y1 sub /h exch def
    x2 x1 sub /w exch def
    dep ydep rlineto
    0 h rlineto
    top 0 ne { BARTOP } if
} bind def

/BARTOP
{
    w neg 0 rlineto
    dep neg ydep neg rlineto
    w 0 rlineto
    dep ydep rlineto
    0 h neg rlineto
    closepath
} bind def

% ----------------------------------------------------------------------
% x1 y1 x2 y2       PBR    fill rectangle (x1,y1)-(x2,y2)
% ----------------------------------------------------------------------
/PBR
{
    REC FILL
} bind def

% ----------------------------------------------------------------------
% xc yc th1 th2 a b EPATH  elliptical path
% ----------------------------------------------------------------------
/EPATH
{
    /savematrix matrix currentmatrix def
    6 -2 roll translate scale
    0 0 1 5 -2 roll arc
    savematrix setmatrix
} bind def

% ----------------------------------------------------------------------
% xc yc th1 th2 a b ARC    draw an elliptical arc
% ----------------------------------------------------------------------
/ARC
{
    gsave
    newpath EPATH [] 0 setdash SK
    grestore
} bind def

% ----------------------------------------------------------------------
% xc yc th1 th2 a b PIE    draw and fill an elliptical pieslice
% ----------------------------------------------------------------------
/PIE
{
    gsave
    newpath
    6 -2 roll 2 copy moveto 6 2 roll
    EPATH closepath FILL SK
    grestore
} bind def

% ----------------------------------------------------------------------
% xc yc a b         ELI    draw and fill an ellipse
% ----------------------------------------------------------------------
/ELI
{
    4 2 roll 0 360 6 -2 roll
    gsave
    newpath EPATH FILL SK
    grestore
} bind def

% ----------------------------------------------------------------------
% x y dx dy (text)  TXT    draw text at x,y
% ----------------------------------------------------------------------
/TXT
{
    gsave
    DrawColor CS
    5 -2 roll translate TxtDir 0 ne { 90 rotate } if
    3 1 roll MoveChar mul 2 div
    exch 2 index stringwidth pop mul 2 div
    exch moveto show
    grestore
} bind def

% ----------------------------------------------------------------------
% size dir font   TXS     sets text size
% ----------------------------------------------------------------------
/TXS
{
    /CurFont exch def /TxtDir exch def  /TxtHt exch def
    CurFont findfont TxtHt scalefont setfont
    /MoveChar TxtHt def
%   newpath 0 0 moveto
%   (0|h) false charpath flattenpath pathbbox newpath
%   /MoveChar exch def 3 { pop } repeat
} bind def

% ----------------------------------------------------------------------
% array             LD      defines line style
% ----------------------------------------------------------------------
/LD
{
    dup /LineStyle exch def 0 setdash
} bind def


% ----------------------------------------------------------------------
% draw              DC      defines draw color
% fill              FC      defines fill color
% aux               AC      defines auxiliary color
% ----------------------------------------------------------------------
/DC { /DrawColor exch def } bind def
/FC { /FillColor exch def } bind def
/AC { /AuxColor  exch def } bind def

% ----------------------------------------------------------------------
% pat#              FD      defines fill pattern
% ----------------------------------------------------------------------
/FD
{
    /FillStyle exch def
} bind def

% ----------------------------------------------------------------------
% patstr            FPD     defines user fill
% ----------------------------------------------------------------------
/FPD
{
    /UserPat exch def  /FillStyle 25 def
} bind def

% ----------------------------------------------------------------------
% color             CS      select  color
% ----------------------------------------------------------------------
/CS
{
    dup type /arraytype ne { setgray }{ {} forall setrgbcolor } ifelse
} bind def

% ----------------------------------------------------------------------
% x1 y1 x2 y2       CLIP   set clipping region
% ----------------------------------------------------------------------
/CLIP
{
    transform round exch round exch itransform 4 2 roll
    transform round exch round exch itransform 4 2 roll
    grestore gsave   % reset to INXX state
    0 setlinewidth REC eoclip newpath
    % restore current graphics state
    TxtHt TxtDir CurFont TXS
    LineWidth setlinewidth
    LineStyle 0 setdash
} bind def


% ----------------------------------------------------------------------
% no                LW      set line width
% ----------------------------------------------------------------------
/LW
{
    StdLine mul dup /LineWidth exch def setlinewidth
} bind def

% ----------------------------------------------------------------------
% Width Height Orient Left Top     INXX    Initialize Page
% Orient: 0=portrait, 1=landscape
% ----------------------------------------------------------------------
/INXX
{
    /PGstate save def
    /ptm
    [
        0.5 0.5 matrix defaultmatrix dtransform xround exch xround exch
        0 exch 0 exch 0 0
    ] def
    2 index 0 ne   % if landscape
    {
        /ptm
        [
            ptm aload pop 6 2 roll 4 2 roll neg exch neg exch 6 -2 roll
        ] def
    }
    if

    0.1 0.1 scale translate

    0 eq
    { neg 0 exch translate pop }                % portrait
    { 90 rotate neg exch neg exch translate }   % landscape
    ifelse

    /StdLine
    StdLine dup dtransform roundup exch roundup exch idtransform pop
    def

    /Courier /CourierGD AF
    120 0 /CourierGD TXS
    0 FC 0 DC 1 AC 1 FD 1 LW [] LD 1.415 setmiterlimit
    gsave
} bind def

% ----------------------------------------------------------------------
%                   TERM    Display Page
% ----------------------------------------------------------------------
/TERM
{
    showpage
    PGstate restore
} bind def


% ----------------------------------------------------------------------
% ulx uly width height imagecols imagerows CI  hexdata      ;Color Image
% ----------------------------------------------------------------------
/CI
{
    gsave
    /rows exch def /cols exch def
    4 2 roll translate scale
    /picstr cols string def

    cols rows 8
    [ cols 0 0 rows neg 0 0 ]
    { currentfile picstr readhexstring pop }
    false 3 colorimage
    grestore
} bind def


% ----------------------------------------------------------------------
% ulx uly width height imagecols imagerows bits GI  hexdata ;GrayScale Image
% ----------------------------------------------------------------------
/GI
{
    gsave
    /bits exch def /rows exch def /cols exch def
    4 2 roll translate scale
    /picstr cols bits mul 7 add 8 idiv string def

    cols rows bits
    [ cols 0 0 rows neg 0 0 ]
    { currentfile picstr readhexstring pop }
    image
    grestore
} bind def


% ................ INSERT ANY USER PROCS HERE ........................
%  Always use gsave/grestore around user proc code

% This is an example of a User Proc to display text rotated to any
% angle.  It does not work for stroked fonts, only for DEFAULT_FONT
% and PostScript fonts

/ROT                      %    x y (text) angle ROT
{
    gsave
    DrawColor CS          % select the drawing color
    4 -2 roll translate   % move the origin to (x,y)
    rotate                % rotate to angle
                          % compute coords to center vertically
    0 0 moveto (X) false charpath flattenpath pathbbox newpath
    2 index add -2 div 0 exch moveto pop pop pop
    show
    grestore
} bind def

% ....................................................................

%%EndProlog